home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -in_the_mag- / reader_requests / wild / support / metastuff_b.bas < prev    next >
BASIC Source File  |  2000-02-23  |  9KB  |  335 lines
  1. SCREEN 1,720,455,2,5
  2. WINDOW 1,"METAStuffing ...",(0,0)-(640,400),,1
  3.  
  4. '$INCLUDE BASU:_METAConsts.bas
  5. '$INCLUDE BASU:_CutWord.bas
  6. '$INCLUDE BASU:_LoadMETA.bas
  7. '$INCLUDE BASU:_Prox.bas
  8. '$INCLUDE BASU:_SafeLine.bas
  9. '$INCLUDE BASU:_METAViewTD.bas
  10. '$INCLUDE BASU:_WAITKEY.bas
  11.  
  12. CONST STUCX%=1
  13. CONST STUCY%=2
  14. CONST STUCZ%=3
  15. CONST STUR%=4
  16. CONST STUFACS%=10
  17. CONST STUMAX%=30
  18.  
  19. METAIN$="EscapeLevels:META/Tree.META"
  20. LoadMETA(METAIN$)
  21. WILDOUT$="Ram:Stuff.s"
  22. FOR i=1 TO 12
  23.  READ ObjRef(i)
  24. NEXT i
  25. viewmode&=VIEWMODE_WIRE&+VIEWFLAG_SELSHOW&
  26. CurFace=1
  27.  
  28. ST=100
  29. REPEAT cyc
  30. a$=UCASE$(WAITKEY$)
  31. SELECT CASE a$
  32.  CASE "X"
  33.   EXIT cyc
  34.  CASE "["
  35.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)-ST
  36.  CASE "]"
  37.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)+ST
  38.  CASE "-"
  39.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)-ST
  40.  CASE "+"
  41.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)+ST
  42.  CASE "*"
  43.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)+ST
  44.  CASE "9"
  45.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)-ST
  46.  CASE "2"
  47.   CALL RotRef(STA,REF_J%,REF_K%)
  48.  CASE "8"
  49.   CALL RotRef(-STA,REF_J%,REF_K%)
  50.  CASE "6"
  51.   CALL RotRef(STA,REF_I%,REF_K%)
  52.  CASE "4"
  53.   CALL RotRef(-STA,REF_I%,REF_K%)
  54.  CASE "5"
  55.   CALL RotRef(STA,REF_I%,REF_J%)
  56. END SELECT
  57. GOSUB Refresh
  58. END REPEAT cyc
  59. GOSUB stuffing
  60. END
  61. Refresh:
  62. CALL METAViewTD
  63. CLS
  64. CALL METARedrawTD(1,1,WINDOW(2),WINDOW(3),viewmode&)
  65. RETURN
  66.  
  67.  
  68. DATA 0,0,1000
  69. DATA 1,0,0
  70. DATA 0,1,0
  71. DATA 0,0,1
  72.  
  73. Stuffing:
  74. DIM Stuff(500,STUMAX%),Usf(10)
  75.  
  76. MAXD&=0:BESTA=0:BESTB=0
  77. FOR i=1 TO NDOT-1
  78.  FOR j=i+1 TO NDOT
  79.   D&=(Dot(i,DOTX%)-Dot(j,DOTX%))^2+(Dot(i,DOTY%)-Dot(j,DOTY%))^2+(Dot(i,DOTZ%)-Dot(j,DOTZ%))^2
  80.   IF D&>MAXD& THEN MAXD&=D&:BESTA=i:BESTB=j
  81.  NEXT j
  82. NEXT i
  83.  
  84. BigSCX=(Dot(BESTA,DOTX%)+Dot(BESTB,DOTX%))/2
  85. BigSCY=(Dot(BESTA,DOTY%)+Dot(BESTB,DOTY%))/2
  86. BigSCZ=(Dot(BESTA,DOTZ%)+Dot(BESTB,DOTZ%))/2
  87. BigSR=MAXD&^.5
  88.  
  89. SUB DrawX(x,y,r,c)
  90.  LINE (x-r,y-r)-(x+r,y+r),c
  91.  LINE (x-r,y+r)-(x+r,y-r),c
  92. END SUB
  93.  
  94. FUNCTION METADistancePointFace(f,x,y,z)
  95.  SHARED Face(),Dot(),hx,hy
  96.  Cx=Dot(Face(f,FACPC%),DOTX%)
  97.  Cy=Dot(Face(f,FACPC%),DOTY%)
  98.  Cz=Dot(Face(f,FACPC%),DOTZ%)
  99.  YOSC=Dot(Face(f,FACPC%),DOTYOS%)
  100.  XOSC=Dot(Face(f,FACPC%),DOTXOS%)
  101.  CALL DrawX(XOSC+hx,YOSC+hy,5,3)
  102.  Ax=Dot(Face(f,FACPA%),DOTX%)-Cx
  103.  Ay=Dot(Face(f,FACPA%),DOTY%)-Cy
  104.  Az=Dot(Face(f,FACPA%),DOTZ%)-Cz
  105.  Bx=Dot(Face(f,FACPB%),DOTX%)-Cx
  106.  By=Dot(Face(f,FACPB%),DOTY%)-Cy
  107.  Bz=Dot(Face(f,FACPB%),DOTZ%)-Cz
  108.  xr=x-Cx
  109.  yr=y-Cy
  110.  zr=z-Cz
  111.  Ik=Bz*Ay-Az*By
  112.  Jk=Az*Bx-Bz*Ax
  113.  Kk=By*Ax-Bx*Ay
  114.  Lk=(Ik^2+Jk^2+Kk^2)^.5
  115.  PS=Ik*xr+Jk*yr+Kk*zr
  116.  d=PS/Lk
  117.  METADistancePointFace=d
  118. END FUNCTION
  119.  
  120. SUB SphereDraw(x,y,z,r)
  121.  SHARED hx,hy
  122.  xos=ProX(x,z)+hx
  123.  yos=ProY(y,z)+hy
  124.  ros=ABS((ABS(r)*256)/(z+256))
  125.  PRINT "ros ",ros,xos,yos
  126.  CIRCLE (xos,yos),ros,3,,,1
  127. END SUB
  128.  
  129. ' Condizioni per ogni sfera:
  130. ' essere tangente a tre facce almeno, che determinano quasi tutto.
  131. ' poi, trovate le coordinate del centro in funzione del raggio, provare con tutte
  132. ' le altre facce il raggio massimo.
  133. ' Trovo centro (px,py,pz) in funzione del raggio:
  134. ' sistema 4x3:
  135. ' ax*px+ay*py+az*pz=r*|a| (a è la normale della face!)
  136. ' idem per b e c.
  137. ' L'equazione deriva dalla formula per la distanza face-point: d=ProdScal/|normale|
  138. ' guarda anche la procedura METADistanceFacePoint
  139. ' Risolvo il sistema, lasciando r come parametro.
  140. ' Matrice:     | ax ay az |    | r*|a| |
  141. '        | bx by bz |    | r*|b| |
  142. '        | cx cy cz |    | r*|c| |
  143. ' MA ! ERRORE !
  144. ' px,py,pz erano relativi al punto c di ogni face!
  145. ' cx,cy,cz sono gli assoluti: cx=px-xc(face)
  146. ' L'equazione diventa:
  147. ' ax*cx+ay*cy+az*cz=r*|a|+xc*ax+yc*ay+zc*az
  148. ' NEW: r*|a| = r !  |a| ora è 1 (normalizzati i vettori normali)
  149.  
  150. COLOR 1,0
  151. NSTU=0
  152. MINR=20
  153. 'FOR i=1 TO NDOT
  154.  GOSUB Refresh
  155.  NUSF=0
  156.  FOR j=1 TO NFAC
  157.   IF Face(j,FACPA%)=i OR Face(j,FACPB%)=i OR Face(j,FACPC%)=i THEN NUSF=NUSF+1:Usf(NUSF)=j
  158.  NEXT j
  159.  IF NUSF>=3
  160.   fa=Usf(1)
  161.   fb=Usf(2)
  162.   fc=Usf(3)
  163.  
  164.   PRINT "Faces: ",fa;fb;fc
  165.   
  166.   axc=Dot(Face(fa,FACPC%),DOTX%)
  167.   ayc=Dot(Face(fa,FACPC%),DOTY%)
  168.   azc=Dot(Face(fa,FACPC%),DOTZ%)
  169.   axa=Dot(Face(fa,FACPA%),DOTX%)-axc
  170.   aya=Dot(Face(fa,FACPA%),DOTY%)-ayc
  171.   aza=Dot(Face(fa,FACPA%),DOTZ%)-azc
  172.   axb=Dot(Face(fa,FACPB%),DOTX%)-axc
  173.   ayb=Dot(Face(fa,FACPB%),DOTY%)-ayc
  174.   azb=Dot(Face(fa,FACPB%),DOTZ%)-azc
  175.   kax=azb*aya-aza*ayb
  176.   kay=aza*axb-azb*axa
  177.   kaz=axa*ayb-aya*axb
  178.   lka=(kax^2+kay^2+kaz^2)^.5
  179.   kax=kax/lka
  180.   kay=kay/lka
  181.   kaz=kaz/lka
  182.   bxc=Dot(Face(fb,FACPC%),DOTX%)
  183.   byc=Dot(Face(fb,FACPC%),DOTY%)
  184.   bzc=Dot(Face(fb,FACPC%),DOTZ%)
  185.   bxa=Dot(Face(fb,FACPA%),DOTX%)-bxc
  186.   bya=Dot(Face(fb,FACPA%),DOTY%)-byc
  187.   bza=Dot(Face(fb,FACPA%),DOTZ%)-bzc
  188.   bxb=Dot(Face(fb,FACPB%),DOTX%)-bxc
  189.   byb=Dot(Face(fb,FACPB%),DOTY%)-byc
  190.   bzb=Dot(Face(fb,FACPB%),DOTZ%)-bzc
  191.   kbx=bzb*bya-bza*byb
  192.   kby=bza*bxb-bzb*bxa
  193.   kbz=bxa*byb-bya*bxb
  194.   lkb=(kbx^2+kby^2+kbz^2)^.5
  195.   kbx=kbx/lkb
  196.   kby=kby/lkb
  197.   kbz=kbz/lkb
  198.   cxc=Dot(Face(fc,FACPC%),DOTX%)
  199.   cycy=Dot(Face(fc,FACPC%),DOTY%)
  200.   czc=Dot(Face(fc,FACPC%),DOTZ%)
  201.   cxa=Dot(Face(fc,FACPA%),DOTX%)-cxc
  202.   cya=Dot(Face(fc,FACPA%),DOTY%)-cycy
  203.   cza=Dot(Face(fc,FACPA%),DOTZ%)-czc
  204.   cxb=Dot(Face(fc,FACPB%),DOTX%)-cxc
  205.   cyb=Dot(Face(fc,FACPB%),DOTY%)-cycy
  206.   czb=Dot(Face(fc,FACPB%),DOTZ%)-czcy
  207.   kcx=czb*cya-cza*cyb
  208.   kcy=cza*cxb-czb*cxa
  209.   kcz=cxa*cyb-cya*cxb
  210.   lkc=(kcx^2+kcy^2+kcz^2)^.5
  211.   kcx=kcx/lkc
  212.   kcy=kcy/lkc
  213.   kcz=kcz/lkc                ' fin qui penso sia tutto OK.
  214.                       ' coi vettori normalizzati (lk=1) è meglio.
  215.  
  216.   PRINT "ka ",kax,kay,kaz
  217.   PRINT "kb ",kbx,kby,kbz
  218.   PRINT "kc ",kcx,kcy,kcz
  219.  
  220.   PRINT "oa ",axc,ayc,azc
  221.   PRINT "ob ",bxc,byc,bzc
  222.   PRINT "oc ",cxc,cycy,czc
  223.   
  224.  
  225. ' la matrice:
  226. ' | ax ay az | | ma |
  227. ' | bx by bz | | mb |
  228. ' | cx cy cz | | mc |
  229.  
  230.   ma=axc*kax+ayc*kay+azc*kaz        ' OKVERIFIED
  231.   mb=bxc*kbx+byc*kby+bzc*kbz        ' OKPROBABLY
  232.   mc=cxc*kcx+cycy*kcy+czc*kcz        ' OKPROBABLY
  233.   PRINT "ma,mb,mc ",ma,mb,mc
  234.   det=kax*kby*kcz+kay*kbz*kcx+kaz*kbx*kcy-kaz*kby*kcx-kay*kbx*kcz-kax*kbz*kcy    'OKMIFIDO
  235.   PRINT "det ",det
  236.  
  237. ' ora:
  238. ' cx=        | r|a|+ma ay az|
  239. '        | r|b|+mb by bz|
  240. '        | r|c|+mc cy cz|/det
  241.  
  242.   mako=kby*kcz-kbz*kcy
  243.   mbko=kcy*kaz-kay*kcz
  244.   mcko=kay*kbz-kaz*kby
  245.   PRINT "mxko a,b,c ",mako,mbko,mcko
  246.   cxtn=mako*ma+mbko*mb+mcko*mc    ' termine noto nell'equazione: cx=(cxtn+r*rcxko)/det
  247.   rcxko=mako+mbko+mcko        ' coefficiente del raggio nell'eq sopra.
  248.  
  249.   mako=kbx*kcz-kbz*kcx
  250.   mbko=kcx*kaz-kax*kcz
  251.   mcko=kax*kbz-kaz*kbx
  252.   PRINT "myko a,b,c ",mako,mbko,mcko
  253.   cytn=-(mako*ma+mbko*mb+mcko*mc)    ' termine noto nell'equazione: cy=(cytn+r*rcyko)/det
  254.   rcyko=-(mako+mbko+mcko)        ' coefficiente del raggio nell'eq sopra.
  255.                       ' SEGNO - PERCHE è un posto dispari (seconda colonna)
  256.                     ' + correttamente avrei dovuto cambiare il segno dei mako,mbko,mcko
  257.   mako=kby*kcx-kbx*kcy
  258.   mbko=kcy*kax-kay*kcx
  259.   mcko=kay*kbx-kax*kby
  260.   PRINT "mzko a,b,c ",mako,mbko,mcko
  261.   cztn=mako*ma+mbko*mb+mcko*mc    ' termine noto nell'equazione: cz=(cztn+r*rczko)/det
  262.   rczko=mako+mbko+mcko        ' coefficiente del raggio nell'eq sopra.
  263.   
  264.   ' SEMBRA TUTTO OK FIN QUI !! 
  265.  
  266.   PRINT "ctn x,y,z ",cxtn,cytn,cztn
  267.   PRINT "rko x,y,z ",rcxko,rcyko,rczko
  268. ' ora:
  269. ' cx=(cxtn+r*rcxko)/det
  270. ' cy=(cytn+r*rcyko)/det  
  271. ' cz=(cztn+r*rczko)/det  
  272. ' kfx*cx+kfy*cy+kfz*cz>r*|kf|    per testare le altre facce e trovare il >r possibile.
  273. ' quindi:
  274. ' kfx*cxtn/det+kfy*cytn/det+kfz*cztn/det>r*(|kf|-rcxko/det-rcyko/det-rczko/det)
  275. ' MA! NO!
  276. ' cx assoluti, ma devo relativizzarli! (come ho fatto prima con i ma,mb,mc)
  277. ' la disequazione di prima (2 sopra) diventa:
  278. ' kfx*(cx-fxc)+kfy*(cy-fyc)+kfz*(cz-fzc)>r*|kf|
  279. ' quindi:
  280. ' kfx*(cxtn/det+r*rcxko/det-fxc) ...
  281.   kfxko=cxtn/det
  282.   kfyko=cytn/det
  283.   kfzko=cztn/det
  284.   rkotn=-(rcxko+rcyko+rczko)/det
  285.   PRINT "kfko x,y,z,r",kfxko,kfyko,kfzko,rkotn
  286. ' kfx*(kfxko-fxc)+...>r*(|kf|+rkotn)
  287. ' ftn>r*frko    
  288.  
  289.   rmin=BigSR
  290. '  FOR j=1 TO NFAC
  291. '   IF j<>fa AND j<>fb AND j<>fc
  292. '    fxc=Dot(Face(j,FACPC%),DOTX%)
  293. '    fyc=Dot(Face(j,FACPC%),DOTY%)
  294. '    fzc=Dot(Face(j,FACPC%),DOTZ%)
  295. '    fxa=Dot(Face(j,FACPA%),DOTX%)-fxc
  296. '    fya=Dot(Face(j,FACPA%),DOTY%)-fyc
  297. '    fza=Dot(Face(j,FACPA%),DOTZ%)-fzc
  298. '    fxb=Dot(Face(j,FACPB%),DOTX%)-fxc
  299. '    fyb=Dot(Face(j,FACPB%),DOTY%)-fyc
  300. '    fzb=Dot(Face(j,FACPB%),DOTZ%)-fzc
  301. '    kfx=fzb*fya-fza*cyb
  302. '    kfy=fza*fxb-fzb*cxa
  303. '    kfz=fxa*fyb-fya*cxb
  304. '    lkf=(kfx^2+kfy^2+kfz^2)^.5
  305. '    frko=(lkf+rkotn)
  306. '''    IF frko<=0 THEN PRINT "ERROR!",frko,lkf,rkotn
  307. '    ftn=kfx*(kfxko-fxc)+kfy*(kfyko-fyc)+kfz*(kfzko-fzc)
  308. '    rminf=ftn/frko
  309. '    cxf=(cxtn+rminf*rcxko)/det
  310. '    cyf=(cytn+rminf*rcyko)/det
  311. '    czf=(cztn+rminf*rczko)/det
  312. '    PRINT "frko,ftn",frko,ftn
  313. '    PRINT rmin,cxf,cyf,czf,cxtn,cytn,cztn
  314. '   END IF  
  315. '   IF rminf<rmin THEN rmin=rminf
  316. '  NEXT j
  317.  END IF 
  318.  r=20
  319.  cxf=(cxtn+r*rcxko)/det
  320.  cyf=(cytn+r*rcyko)/det
  321.  czf=(cztn+r*rczko)/det
  322.  PRINT "x,y,z",cxf,cyf,czf
  323.  CALL SphereDraw(cxf,cyf,czf,r)
  324.  
  325.  PRINT "dfa ",METADistancePointFace(fa,cxf,cyf,czf)
  326.  PRINT "dfb ",METADistancePointFace(fb,cxf,cyf,czf)
  327.  PRINT "dfc ",METADistancePointFace(fc,cxf,cyf,czf)
  328. 'NEXT i
  329.  
  330.  
  331.  
  332.  
  333.   
  334.  
  335.